home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / animat1a / graphics.bas next >
BASIC Source File  |  1999-09-25  |  4KB  |  96 lines
  1. Attribute VB_Name = "Graphics"
  2. Option Explicit
  3. Public Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  4. Public Declare Function SetWindowRgn Lib "User32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  5. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  6. Public Declare Function ReleaseCapture Lib "User32" () As Long
  7. Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  8. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  9. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  10. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  11. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  12. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  13. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  14. Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
  15.  
  16. Private Type BITMAP
  17.     bmType As Long
  18.     bmWidth As Long
  19.     bmHeight As Long
  20.     bmWidthBytes As Long
  21.     bmPlanes As Integer
  22.     bmBitsPixel As Integer
  23.     bmBits As Long
  24. End Type
  25.  
  26. Public Const WM_NCLBUTTONDOWN = &HA1
  27. Public Const HTCAPTION = 2
  28.  
  29. Public Const HWND_TOPMOST = -1
  30. Public Const HWND_NOTOPMOST = -2
  31. Public Const SWP_NOACTIVATE = &H10
  32. Public Const SWP_NOMOVE = &H2
  33. Public Const SWP_NOSIZE = &H1
  34.  
  35.  
  36.  
  37. Public Sub TopZ(frm As Form)
  38. Dim lRt As Long
  39. lRt = SetWindowPos(frm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE)
  40. End Sub
  41.  
  42. Public Function GetBitmapRegion(cPicture As StdPicture, cTransparent As Long) As Long
  43. 'It scans the image passed to it and then
  44. 'removes lines that correspond to the transparent
  45. 'color, creating a new virtual image, but no
  46. 'particular color.
  47. Dim hRgn As Long
  48. Dim tRgn As Long
  49. Dim X As Integer
  50. Dim Y As Integer
  51. Dim X0 As Integer
  52. Dim hDC As Long
  53. Dim BM As BITMAP
  54.  
  55. hDC = CreateCompatibleDC(0)
  56. If hDC Then
  57. 'Let the new DC select the Picture
  58. SelectObject hDC, cPicture
  59. 'Get the Picture dimensions and create a new
  60. 'rectangular region
  61. GetObject cPicture, Len(BM), BM
  62. hRgn = CreateRectRgn(0, 0, BM.bmWidth, BM.bmHeight)
  63. 'Start scanning the picture from top to bottom
  64. For Y = 0 To BM.bmHeight
  65. For X = 0 To BM.bmWidth
  66. 'Scan a line of non transparent pixels
  67. While X <= BM.bmWidth And GetPixel(hDC, X, Y) <> cTransparent
  68. X = X + 1
  69. Wend
  70. 'Mark the start of a line of transparent pixels
  71. X0 = X
  72. 'Scan a line of transparent pixels
  73. While X <= BM.bmWidth And GetPixel(hDC, X, Y) = cTransparent
  74. X = X + 1
  75. Wend
  76. 'Create a new Region that corresponds to the row of
  77. 'Transparent pixels and then remove it from the main
  78. 'Region
  79. If X0 < X Then
  80. tRgn = CreateRectRgn(X0, Y, X, Y + 1)
  81. CombineRgn hRgn, hRgn, tRgn, 4
  82. 'Free the memory used by the new temporary Region
  83. DeleteObject tRgn
  84. End If
  85. Next X
  86. Next Y
  87. 'Return the memory address to the shaped region
  88. GetBitmapRegion = hRgn
  89. 'Free memory by deleting the Picture
  90. DeleteObject SelectObject(hDC, cPicture)
  91. End If
  92. 'Free memory by deleting the created DC
  93. DeleteDC hDC
  94.  
  95. End Function
  96.